Shareware Super Platinum 8/Shareware Super Platinum 8.iso/mac/PROGTOOL/EUPHOR10.ZIP;1/DAMAGE.E

Text File | 1993-06-08 | 7.6 KB | 347 lines

-- damage.e
-- compute effects of damage

global function tholian_target(valid_f_row r)
-- select target for tholian at row r
    sequence flive

    flive = {ENTERPRISE}
    for i = fb1 to fnext-1 do
    if i != r and f[i][F_TYPE] then
        flive = flive & i
    end if
    end for
    return flive[rand(length(flive))]
end function

procedure setrmt(valid_f_row newtarg)
-- set Romulan target

    rtarg = newtarg
    if rstat = TRUCE then
    if rtarg = ENTERPRISE or f[rtarg][F_TYPE] = G_BS then
        truce_broken = TRUE
        sched(TASK_RSTAT, 2.5)
    end if
    end if
    for row = fr1 to fnext-1 do
    if f[row][F_TYPE] = G_RM then
        f[row][F_TARG] = rtarg
    end if
    end for
end procedure

procedure setnt()
-- target is dead - pick new target
    positive_int t -- object_type t or t = 0
    valid_f_row targ

    for row = fb1 to fnext-1 do
    if f[row][F_TARG] = victim then
        t = f[row][F_TYPE]
        if t = G_BS then
        f[row][F_FRATE] = 0
        else
        if t = G_TH then
            targ = tholian_target(row)
        else
            targ = ENTERPRISE
        end if
        f[row][F_TARG] = targ
        end if
    end if
    end for
    if victim = rtarg then
    rtarg = ENTERPRISE
    end if
end procedure

global procedure repair(subsystem sys)
-- repair a subsystem
    if sys = ENGINES then
    wlimit = 5
    set_bk_color(WHITE)
    set_color(BLACK)
    position(WARP_LINE, 8)
    printf(CRT, "%d   ", curwarp)
    end if
    ndmg = ndmg - 1
end procedure

procedure edmg(positive_atom blast)
-- Enterprise damage
    subsystem sys

    if blast > rand(256) * 60 then
    sys = rand(NSYS)
    if reptime[sys] = 0 then
        sounde(11, 12, 5)
        reptime[sys] = rand(81) + 9
        if sys = GALAXY_SENSORS then
        setg1()
        end if
        msg("")
        if sys = ENGINES then
        wlimit = rand(4) - 1
        if curwarp > wlimit then
            setwarp(wlimit)
            msg("")
            if wlimit = 0 then
            puts(CRT, "ALL ")
            end if
        end if
        end if
        printf(CRT, "%s DAMAGED", {dtype[sys]})
        wait[TASK_DAMAGE] = 2.0
        ndmg = ndmg + 1
        sched(TASK_DAMAGE, 2.0)
    end if
    end if
end procedure

global procedure drep()
-- damage report update
    set_bk_color(GREEN)
    set_color(BRIGHT_WHITE)
    position(WARP_LINE, 50)
    puts(CRT, repeat(' ', 13))
    position(WARP_LINE+1, 50)
    puts(CRT, repeat(' ', 13))
    position(WARP_LINE, 51)
    printf(CRT, "P%d T%d S%d", {reptime[PHASORS],
                reptime[TORPEDOS],
                reptime[GALAXY_SENSORS]})
    position(CMD_LINE, 51)
    printf(CRT, "G%d E%d", {reptime[GUIDANCE], reptime[ENGINES]})
    if reptime[ENGINES] > 0 then
    printf(CRT, ":%d", wlimit)
    end if
end procedure

global procedure t9dmg()
-- task 9: damage countdown

    if ndmg = 0 then
    wait[TASK_DAMAGE] = 0
    set_bk_color(WHITE)
    position(WARP_LINE, 50)
    puts(CRT, repeat(' ', 13))
    position(WARP_LINE+1, 50)
    puts(CRT, repeat(' ', 13))
    else
    for i = 1 to NSYS do
        if reptime[i] then
        reptime[i] = reptime[i] - 1
        if reptime[i] = 0 then
            sounde(6, 20, 1)
            repair(i)
            msg("")
            printf(CRT, "%s REPAIRED", {dtype[i]})
        end if
        end if
    end for
    drep()
    end if
end procedure

global function fstart(object_type t)
-- choose a starting point for f search
    if t <= G_JM then
    return fk1
    elsif t = G_RM then
    return fr1
    elsif t = G_TH then
    return ft1
    elsif t = G_PL then
    return ENTERPRISE + 1
    else
    return fb1
    end if
end function

global function flook(h_coord x, v_coord y, boolean src_chk)
-- map (x,y) screen coordinate to f array row
-- src_chk is true when we just want to see if we are docking

    extended_h_coord ix
    extended_v_coord iy
    positive_int t, len, xend

    xend = x + length(esym) - 1
    for i = ENTERPRISE + src_chk to fnext-1 do
    ix = f[i][F_X]
    iy = f[i][F_Y]
    t = f[i][F_TYPE]

    if t = G_BS then
        if x >= ix and x < ix + length(BASE) and
           y >= iy and y < iy + 2 then
           return i
        end if
        if src_chk then
        -- check other end of Enterprise too
        -- (assumes base is reasonably wide)
        if xend >= ix and xend < ix + length(BASE) and
           y >= iy and y < iy + 2 then
            return i
        end if
        end if

    elsif t = G_PL then
        if x >= ix and x < ix + length(PLANET_MIDDLE) and
           y >= iy and y < iy + 3 then
        return i
        end if
        if src_chk then
        -- check other end of Enterprise too
        -- (assumes planet is reasonably wide)
        if xend >= ix and xend < ix + length(PLANET_MIDDLE) and
           y >= iy and y < iy + 3 then
            return i
        end if
        end if

    elsif t then
        if i = ENTERPRISE then
        len = length(esym)
        else
        len = length(ship[t][1])
        end if
        if x >= ix and x < ix + len and y = iy then
        return i
        end if
        if src_chk then
        -- check other end too
        if xend >= ix and xend < ix + len and y = iy then
            return i
        end if
        end if
    end if
    end for
end function


procedure dead(valid_f_row row)
-- process a dead object

    object_type t
    h_coord x
    v_coord y
    pb_row pbx
    positive_int len

    t = f[row][F_TYPE]
    if row = ENTERPRISE then
    -- Enterprise destroyed !
    f[ENTERPRISE][F_EN] = 0
    p_energy(-1)
    else
    sounde(10,3,1)
    urt = t
    ur = 0
    nobj[t] = nobj[t] - 1
    g[qrow][qcol][urt] = g[qrow][qcol][urt] - 1
    x = f[row][F_X]
    y = f[row][F_Y]
    set_bk_color(BLACK)
    set_color(BRIGHT_WHITE)
    if t >= G_PL then
        pbx = f[row][F_PBX]
        pb[pbx][P_EXIST] = DESTROYED
        if scanon then
        dsyms()
        end if
        if t = G_BS then
        len = length(BASE)
        for i = 0 to 1 do
            display_screen(x, y + i, repeat('*', len))
            wipeout = append(wipeout, {x, y + i, len})
        end for
        else
        len = length(PLANET_MIDDLE)
        for i = 0 to 2 do
            display_screen(x, y + i, repeat('*', len))
            wipeout = append(wipeout, {x, y + i, len})
        end for
        end if
    else
        len = length(ship[t][1])
        display_screen(x, y, repeat('*', len))
        wipeout = append(wipeout, {x, y, len})
        if nkl() = 0 then
        gameover = TRUE
        end if
    end if
    f[row][F_TYPE] = 0 -- indicates dead guy
    f[row][F_X] = HSIZE + 1
    f[row][F_Y] = VSIZE + 1
    setnt()
    sched(TASK_UREM, 1.0)
    sched(TASK_DEAD, 1.6)
    end if
    explosion_sound()
    if scanon then
    upg(qrow, qcol)
    gsbox(qrow, qcol)
    gtext()
    end if
end procedure

global procedure dodmg(positive_atom blast, boolean wtorp)
-- damage a struck object
    object_type t
    positive_int d
    positive_atom ven

    msg("")
    t = f[victim][F_TYPE]
    if t = G_RM then
    setrmt(shooter)
    else
    f[victim][F_TARG] = shooter
    end if
    if wtorp then
    -- torpedo
    d = f[victim][F_DEFL]
    if d then
        puts(CRT, "DEFLECTED")
        f[victim][F_DEFL] = d-1
        ds = repeat(DEFLECTOR, f[ENTERPRISE][F_DEFL])
        wtext()
        blast = 0
    end if
    end if
    if blast then
    if t <= G_TH then
        printf(CRT, "%d UNIT HIT ON %s", {blast, otype[t]})
    end if
    ven = f[victim][F_EN]
    if blast >= ven then
        dead(victim)
    else
        ven = ven - blast
        f[victim][F_EN] = ven
        if t <= G_TH then
        if victim = ENTERPRISE then
            p_energy(0)
            edmg(blast)
        else
            ur = ven
            sched(TASK_UREM, 1.0)
        end if
        end if
    end if
    end if
end procedure

global constant ASPECT_RATIO = 3 -- roughly

global function bcalc(positive_atom energy)
-- calculate amount of phasor blast
    atom xdiff, ydiff

    xdiff = f[victim][F_X] - f[shooter][F_X]
    ydiff = (f[victim][F_Y] - f[shooter][F_Y]) * ASPECT_RATIO
    return 200 * energy / (5 + sqrt(xdiff * xdiff + ydiff * ydiff))
end function